unit uSockSvr;

interface

uses
  SysUtils, Classes, Windows, uDZSysUtils, uDZStr, uDZStream, uDZTrace, uDZPersistent,
  uDZThread, uDZSocket, uDZWinsock2, uDZInetProto, uDZIOCP, uDZHashTable,
  uLBMPPackage, uAppConfig, uAppLog;

{.$define output_request_xml}

type
  TRequestState = (rsHeader, rsContent, rsHttp);
  TNetConnection = class(TDzServerConnection)
  private
    IP: AnsiString;
    Port: Integer;
    State: TRequestState;
    ReqBuf: array [0..2047] of AnsiChar;
    BufPtr: Integer;
  private
    procedure ReadContent;
    procedure ReadHttpRequest;
    procedure ReadHeader;
  public
    function Close: Boolean; override;
    procedure OnConnect;
    procedure OnFixedHeader;
    procedure OnContent;
    procedure OnHttp(Size: Integer);
  end;

  TNetAcceptor = class(TDzCustomServerSocket)
  public
    function Close: Boolean; override;
  end;

function PostAsyncAccept(Acceptor: TNetAcceptor; Number: Cardinal): Cardinal;
procedure CloseConnections;

implementation

uses
  uLbmpPkgProcessor;

var
  ClientTableLock: TDzCriticalSection;
  ClientTable: TDzAnsiStrHashTable;

procedure AcceptCallback(Sender: PDzIocpIOService;
  Socket: TDzCustomServerSocket;
  Operation: PDzAsyncAccept); forward;

function AsyncAccept(Acceptor: TDzCustomServerSocket;
  Connection: TDzServerConnection): Boolean;
var
  LastError: Integer;
begin
  Result := Acceptor.AsyncAccept(Connection, @AcceptCallback, @LastError);
  if not Result then
  begin
    FmtWriteLog(tsError, 'accept error: %d'#10, [LastError]);
  end;
end;

function PostAsyncAccept(Acceptor: TNetAcceptor; Number: Cardinal): Cardinal;
var
  i: Cardinal;
  Connection: TNetConnection;
begin
  Result := 0;
  for i := 1 to Number do
  begin
    Connection := TNetConnection.Create;
    if AsyncAccept(Acceptor, Connection) then Inc(Result)
    else begin
      Connection.Free;
      Break;
    end;
  end;
end;

procedure CloseConnections;
var
  Iterator: TDzAnsiStrHashTableIterator;
  Socket: TDzCustomSocket;
begin
  ClientTableLock.Acquire;
  try
    Iterator.SetTable(ClientTable);
    while not Iterator.Eof do
    begin
      Socket := TDzCustomSocket(Iterator.value);
      Iterator.Inc;
      Socket.Close;
    end;
  finally
    ClientTableLock.Release;
  end;
end;

procedure AcceptCallback(Sender: PDzIocpIOService; Socket: TDzCustomServerSocket;
  Operation: PDzAsyncAccept);
var
  BytesTrans, Flags: DWORD;
  LastError: Integer;
begin
  try
    if WSAGetOverlappedResult(Operation^.Connection.Handle,
      POverlapped(Operation), BytesTrans, False, Flags) then
    with TNetConnection(Operation.Connection) do
    begin
      UpdateAcceptContext(Socket);
      PostAsyncAccept(TNetAcceptor(Socket), 1);
      Sender.Bind(Handle, Operation.Connection);
      OnConnect;
    end
    else begin
      LastError := WSAGetLastError;
      FmtWriteLog(tsError, 'accept error: %d'#10, [LastError]);
      if LastError = ERROR_OPERATION_ABORTED then
      begin
        Operation.Connection.Close;
        Socket.Close;
      end
      else begin
        if AsyncAccept(Socket, Operation.Connection) then
        begin
          Operation.Connection.Close;
          Socket.Close;
        end;
      end;
    end;
  finally
    Socket.DeallocAcceptOperation(Operation);
    Socket.Release;
  end;
end;

procedure RecvCallback(Sender: TDzIocpIOService; Socket: TDzCustomConnection;
  Operation: PDzAsyncRecv);
var
  BytesTrans, Flags: DWORD;
  Connection: TNetConnection absolute Socket;
begin
  try
    if not WSAGetOverlappedResult(Connection.Handle,
      POverlapped(Operation), BytesTrans, False, Flags) then
    begin
      FmtWriteLog(tsError, 'recv error: %d'#10, [WSAGetLastError]);
      Socket.Close;
      Exit;
    end;
    if BytesTrans = 0 then
    begin
      Socket.Close;
      WriteLog(tsDebug, 'connection closed gracefully'#10);
      Exit;
    end;
    case Connection.State of
      rsHeader: Connection.OnFixedHeader;
      rsContent: Connection.OnContent;
      rsHttp: Connection.OnHttp(BytesTrans);
    end;
  finally
    Connection.DeallocRecvOperation(Operation);
    Socket.Release;
  end;
end;

{ TNetConnection }

function TNetConnection.Close: Boolean;
begin
  Result := inherited Close;
  if Result then
  begin
    if IP <> '' then
    begin
      ClientTableLock.Acquire;
      try
        ClientTable.Delete(Format('%s,%d', [IP, Port]));
      finally
        ClientTableLock.Release;
      end;
    end;
    Release;
  end;
end;

procedure TNetConnection.OnFixedHeader;
var
  PkgHdr: PLbmpPkgHdr;
begin
  PkgHdr := PLbmpPkgHdr(@ReqBuf);
  if (PkgHdr.Signature[0] in ['G', 'g']) and (PkgHdr.Signature[1] in ['E', 'e']) and
    (PkgHdr.Signature[2] in ['T', 't']) and (PkgHdr.Signature[3] = #32) then
  begin
    State := rsHttp;
    BufPtr := 0;
    OnHttp(SizeOf(TLbmpPkgHdr));
    Exit;
  end;
  if not PkgHdr.IsValid then
  begin
    WriteLog(tsError, 'invalid request header, close connection'#10);
    Close;
    Exit;
  end;
  State := rsContent;
  ReadContent;
end;

function GetRequestType(FilePtr, FileEnd: PAnsiChar): TRequestType;
var
  Dot: PAnsiChar;  
begin
  //ignore filename extension
  Dot := FilePtr;
  while (Dot < FileEnd) and (Dot^ <> '.') do Inc(Dot);
  FileEnd := Dot;
  if FilePtr = FileEnd then
  begin
    Result := rtUnknown;
    Exit;
  end;

  if AnsiCompare(FilePtr, FileEnd - FilePtr, 'ServerInfo',
    Length('ServerInfo'), [coIgnoreCase]) = crEqual then Result := rtServerInfo
  else if AnsiCompare(FilePtr, FileEnd - FilePtr, 'GetLBSState',
    Length('GetLBSState'), [coIgnoreCase]) = crEqual then Result := rtGetState
  else if AnsiCompare(FilePtr, FileEnd - FilePtr, 'Register',
    Length('Register'), [coIgnoreCase]) = crEqual then Result := rtReg
  else if AnsiCompare(FilePtr, FileEnd - FilePtr, 'ConfirmRegister',
    Length('ConfirmRegister'), [coIgnoreCase]) = crEqual then Result := rtAgreeReg
  else if AnsiCompare(FilePtr, FileEnd - FilePtr, 'UnRegister',
    Length('UnRegister'), [coIgnoreCase]) = crEqual then Result := rtUnReg
  else if AnsiCompare(FilePtr, FileEnd - FilePtr, 'GetAreaCode',
    Length('GetAreaCode'), [coIgnoreCase]) = crEqual then Result := rtCityLoc
  else if AnsiCompare(FilePtr, FileEnd - FilePtr, 'GetCoord',
    Length('GetCoord'), [coIgnoreCase]) = crEqual then Result := rtCoordLoc
  else if AnsiCompare(FilePtr, FileEnd - FilePtr, 'ShowMap',
    Length('ShowMap'), [coIgnoreCase]) = crEqual then Result := rtShowMap
  else Result := rtUnknown;
end;

function GetPhoneParam(ParamPtr, ParamEnd: PAnsiChar): AnsiString;
var
  Ptr, ParamName, ParamValue: PAnsiChar;
begin
  Result := '';
  ParamName := ParamPtr;
  while True do
  begin
    Ptr := ParamName;
    while (Ptr < ParamEnd) and (Ptr^ <> '=') do Inc(Ptr);
    if Ptr = ParamEnd then Exit;
    ParamValue := Ptr;
    while (Ptr < ParamEnd) and (Ptr^ <> '&') do Inc(Ptr);
    if (AnsiCompare(ParamName, ParamValue - ParamName, 'PhoneNumber',
      Length('PhoneNumber'), [coIgnoreCase]) = crEqual) or
      (AnsiCompare(ParamName, ParamValue - ParamName, 'Phone',
      Length('Phone'), [coIgnoreCase]) = crEqual) then
    begin
      Result := AnsiStrFromBuf(ParamValue + 1, Ptr - ParamValue - 1);
      Exit;
    end
    else begin
      if Ptr = ParamEnd then Exit;
      ParamName := Ptr + 1;
    end;
  end;    
end;

procedure TNetConnection.OnHttp(Size: Integer);
var
  HttpReq: THttpReqLine;
  ReqType: TRequestType;
  Phone: AnsiString;
begin
  Inc(BufPtr, Size);
  if (ReqBuf[BufPtr - 1] = #10) and (ReqBuf[BufPtr - 2] = #13)
    and (ReqBuf[BufPtr - 3] = #10) and (ReqBuf[BufPtr - 4] = #13) then
  begin
    if not HttpParseReqLine(ReqBuf, BufPtr, HttpReq) then
    begin
      Close;
      Exit;
    end;
    ReqType := GetRequestType(HttpReq.FileFirst, HttpReq.FileLast);
    if ReqType = rtUnknown then
    begin
      Close;
      Exit;
    end;

    if ReqType in [rtGetState..rtShowMap] then
    begin
      Phone := GetPhoneParam(HttpReq.ParamFirst + 1, HttpReq.ParamLast);
      if Phone = '' then begin Close; Exit; end;
      FmtWriteLog(tsInformation, '%s %s(%d bytes)'#10,
        [ReqTypeNames[ReqType], Phone, BufPtr]);
    end
    else begin
      Phone := '';
      FmtWriteLog(tsInformation, '%s(%d bytes)'#10,
        [ReqTypeNames[ReqType], BufPtr]);
    end;

    if ProcessHttpRequest(Self, ReqType, Phone) then
    begin
      State := rsHeader;
      ReadHeader;
    end
    else Close;
  end
  else ReadHttpRequest;
end;

procedure TNetConnection.OnConnect;
var
  SessID: AnsiString;
begin
  if (AppConfig.WhiteList.Count = 0) or (AppConfig.WhiteList.IndexOf(RemoteAddr) >= 0) then
  begin
    IP := RemoteAddr;
    Port := RemotePort;
    SessID := Format('%s,%d', [IP, Port]);
    FmtWriteLog(tsDebug, '{%s} connected.'#10, [SessID]);
    ClientTableLock.Acquire;
    try
      ClientTable.Insert(SessID, Self, nil, False);
    finally
      ClientTableLock.Release;
    end;
    ReadHeader;
  end
  else begin
    FmtWriteLog(tsDebug, 'refuse connection {%s}'#10, [
      Format('%s,%d', [RemoteAddr, RemotePort])]);
    Close;
  end;
end;

procedure TNetConnection.OnContent;
var
  //array [0..TDzMemoryStream.InstanceSize - 1] of Byte;
  StackObject: array [0..19] of Byte;
  MemoryStream: TDzMemoryStream;
  Request: TRequestPackage;
  PkgHdr: PLbmpPkgHdr;
  Phones: string;
begin
  PkgHdr := PLbmpPkgHdr(@ReqBuf);
  FillChar(StackObject, SizeOf(StackObject), 0);
  PPointer(@StackObject)^ := TDzMemoryStream;
  MemoryStream := TDzMemoryStream(@StackObject);
  MemoryStream.SetPointer(ReqBuf + SizeOf(TLbmpPkgHdr), PkgHdr.DataLen);
  Request := RequestClasses[TRequestType(PkgHdr.ReqType)].Create;
  try
    Request.LoadFromStream(MemoryStream, TDzArchiveFormat(PkgHdr.Format));
    if Request.ReqType in [rtGetState..rtCoordLoc] then
      Phones := TREQMultiPhone(Request).Phones.CommaText
    else Phones := '';
    FmtWriteLog(tsInformation, '%s %s(%d bytes)'#10,
      [ReqTypeNames[TRequestType(PkgHdr.ReqType)], Phones, PkgHdr.DataLen]);
    {$ifdef output_request_xml}
    Writelog(tsDebug, Request.AsXML + #10);
    {$endif}
    State := rsHeader;
    Self.AddRef;
    if ProcessPackage(Self, Request) then
    begin
      Request := nil;
      ReadHeader;
    end
    else Close;
  finally
    MemoryStream.Extract;
    Request.Free;
  end;
end;

procedure TNetConnection.ReadContent;
var
  LastError: Integer;
begin
  if not AsyncRecv(ReqBuf[SizeOf(TLbmpPkgHdr)], PLbmpPkgHdr(@ReqBuf).DataLen,
    @RecvCallback, @LastError, MSG_WAITALL) then
  begin
    FmtWriteLog(tsError, 'recv error: %d'#10, [LastError]);
    Close;
  end;
end;

procedure TNetConnection.ReadHeader;
var
  LastError: Integer;
begin
  if not AsyncRecv(ReqBuf, SizeOf(TLbmpPkgHdr), @RecvCallback,
    @LastError, MSG_WAITALL) then
  begin
    FmtWriteLog(tsError, 'recv error: %d'#10, [LastError]);
    Close;
  end;
end;

procedure TNetConnection.ReadHttpRequest;
var
  LastError: Integer;
begin
  if not AsyncRecv(ReqBuf[BufPtr], SizeOf(ReqBuf) - BufPtr,
    @RecvCallback, @LastError, 0) then
  begin
    FmtWriteLog(tsError, 'recv error: %d'#10, [LastError]);
    Close;
  end;
end;

{ TNetAcceptor }

function TNetAcceptor.Close: Boolean;
begin
  Result := inherited Close;
  if Result then Release;
end;

initialization
  ClientTableLock := TDzCriticalSection.Create(100);
  ClientTable := TDzAnsiStrHashTable.Create(CalcHashTableSize(100));

finalization
  ClientTable.Free;
  ClientTableLock.Free;
end.

